unit uSBDUnit_OldStyleMMState_LeakageDetector;
interface
uses uSBDUnit_MemoryManagement, Classes, uSBDUnit_TestNode_InternalSupport,
     uSBD_BaseTypes, uSBD_ServiceProvider;

type
TMMState_LeakageMeter = class( TSBD_RefCountedCommonBase, ILeakageDetector)
  private
    FReferenceAllocation: int64;
    FReferenceSuppressionAllocation: int64;
    FSuppressionExclusionAmount: int32;
    FisMonitoring: boolean;
    FMonitoringSuppression: TObject;
    [Injection('New')] FOwnProvider: IServiceProvider;

    procedure EnterMonitoringSuppression;
    procedure LeaveMonitoringSuppression;
    function  StockTake: int64;

  public
    [Configuration] constructor Create;
    destructor  Destroy; override;

    procedure EnterMonitoring;
    function  LeaveMonitoring( var Leakage: int64): boolean;
    function  IsMonitoring: boolean;
    function  MonitoringSuppression: IInterface;
  end;


implementation






uses SysUtils;
type
TMonitoringSuppression = class( TSBD_RefCountedCommonBase)
  private
    FOwner: TMMState_LeakageMeter;

  protected
    procedure SetParentNodeAsIntf( const Value: IInterface);   override;

  public
    [Configuration('Suppression')] constructor Create;
    destructor Destroy; override;
  end;




function StockTake( const MMS: TMemoryManagerState): int64;
var
  j: integer;
begin
result := 0;
for j := 0 to NumSmallBlockTypes - 1 do
  result := result + (MMS.SmallBlockTypeStates[j].InternalBlockSize *
                      MMS.SmallBlockTypeStates[j].AllocatedBlockCount);
result := result + Int64( MMS.TotalAllocatedMediumBlockSize) +
                   Int64( MMS.TotalAllocatedLargeBlockSize )
end;

{ TMMState_LeakageMeter }

constructor TMMState_LeakageMeter.Create;
begin
Assert( not UseMemoryMetering, 'Wrong Memory Management Model!');
FServiceProvider := nil;
TMonitoringSuppression.RegisterThis( FOwnProvider, IInterface)
end;


function TMMState_LeakageMeter.StockTake: int64;
var
  MMS: TMemoryManagerState;
begin
GetMemoryManagerState( MMS);
result := uSBDUnit_OldStyleMMState_LeakageDetector.StockTake( MMS)
end;

destructor TMMState_LeakageMeter.Destroy;
begin
Assert( not Assigned( FMonitoringSuppression), 'MonitoringSupression not released. Bad!');
inherited;
end;

procedure TMMState_LeakageMeter.EnterMonitoring;
begin
if FisMonitoring then exit;
FisMonitoring := True;
FReferenceAllocation := StockTake;
FReferenceSuppressionAllocation := 0;
FSuppressionExclusionAmount     := 0;
end;

function TMMState_LeakageMeter.IsMonitoring: boolean;
begin
result := FisMonitoring
end;

function TMMState_LeakageMeter.LeaveMonitoring( var Leakage: int64): boolean;
var
  Base: int64;
begin
Leakage := 0;
result  := True;
if not FisMonitoring then exit;
FisMonitoring := False;
if assigned( FMonitoringSuppression) then
    Base := FReferenceSuppressionAllocation
  else
    Base := FReferenceAllocation;
Leakage := StockTake - Base - FSuppressionExclusionAmount;
result  := Leakage = 0
end;

procedure TMMState_LeakageMeter.EnterMonitoringSuppression;
begin
FReferenceSuppressionAllocation := StockTake
end;

procedure TMMState_LeakageMeter.LeaveMonitoringSuppression;
begin
FSuppressionExclusionAmount :=
  FSuppressionExclusionAmount + (StockTake - FReferenceSuppressionAllocation)
end;

function TMMState_LeakageMeter.MonitoringSuppression: IInterface;
begin
if not Supports( FMonitoringSuppression, IInterface, result) then
  FOwnProvider.Acquire( nil, IInterface, result, 'Suppression')
end;

{ TMonitoringSuppression }

constructor TMonitoringSuppression.Create;
begin
FOwner.FMonitoringSuppression := self;
FOwner.EnterMonitoringSuppression
end;


destructor TMonitoringSuppression.Destroy;
begin
FOwner.LeaveMonitoringSuppression;
FOwner.FMonitoringSuppression := nil;
inherited;
end;


procedure TMonitoringSuppression.SetParentNodeAsIntf( const Value: IInterface);
begin
if assigned( Value) then
  FOwner := TObject( Value) as TMMState_LeakageMeter
end;

end.
